home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Turnbull China Bikeride
/
Turnbull China Bikeride - Disc 2.iso
/
STUTTGART
/
LANG
/
FORTH
/
FORTHMAC
/
OLD
/
TOOLS1
/
!Forthmacs.lib.arm.debug
< prev
next >
Wrap
Text File
|
1996-05-30
|
5KB
|
129 lines
\ This debugger is better adapted to the risc_os environment.
\ uses text-environment debugger window
\ Debugger. Thanks, Mike Perry, Henry Laxen, Mark Smeder.
\
\ The debugger lets you single step the execution of a high level
\ definition. To invoke the debugger, type debug xxx where xxx is
\ the name of the word you wish to trace. When xxx executes, you will
\ get a single step trace showing you the word within xxx that
\ is about to execute, and the contents of the parameter stack.
\ Debugging makes everything run slightly slower, even outside
\ the word being debugged. see debug-off
\
\ debug name Mark that word for debugging
\ step Debug in single step mode
\ trace Debug in trace mode
\ debug-off Turn off the debugger (makes the system run fast again)
\ resume Exit from a pushed interpreter (see the f keystroke)
\
\ Keystroke commands while you're single-stepping:
\ d go down a level
\ u go up a level
\ c continue; trace without single stepping
\ g go; turn off stepping and continue execution
\ f push a Forth interpreter; execute "resume" to get back
\ q abort back to the top level
only forth also hidden also bug also definitions
: interpret-line \ input-line ( -- ?? )
0 0 0 0 0 prompt 2drop 2drop drop \ Hack to make showstack work
astring dup char+ 80 expect span @ over c! count evaluate ;
hex
variable slow-next? slow-next? off
variable used-window \ points to pfa of used window
create vid-par 16 allot
: set-used-window \ ( -- )
used-window @ 2@ used-window @ 2 cells+ 2@ (window
used-window @ 4 cells+ 2@ at-xy ;
: window \ name ( x-left y-bot x-right y-top -- )
create 2>r , , 2r> , , ( cursor position ) 0 , 0 ,
does> \ first save old window
dup used-window @ = if drop exit then
used-window @ if at-xy? used-window @ 4 cells+ 2! then
used-window !
set-used-window ;
lcol trow 12 + rcol 1- trow window debugger-window
lcol brow rcol 1- trow 14 + window forth-window
: -line ( -- ) #columns 1- #out @ - 0 max 0 ?do [char] - emit loop ;
: one-window ( -- ) vid-par 2 cells+ 2@ vid-par 2@ (window ;
variable last-string
: .dinfo \ ( str -- )
dup last-string @ = if drop exit then
dup last-string !
at-xy? rot one-window 0 13 at-xy marked ." -- " ". space -line light
set-used-window at-xy ;
: .dtitle p" RISC OS Forthmacs debugger" .dinfo ;
: .dkeyinfo p" [<space> Down Up Continue Forth Go Quit]" .dinfo ;
: .dcont p" [ <any key> to stop ]" .dinfo ;
: .dresume p" > resume < restarts debugger" .dinfo ;
: two-windows
(get-window vid-par 2! vid-par 2 cells+ 2!
erase-screen .dtitle forth-window ;
variable step? step? on
variable res
: (debug) (s low-adr hi-adr -- )
\ Silently refuse to debug the kernel; it's too dangerous
over low-dictionary-adr ( fence @ ) ['] alias between if 2drop exit then
unbug 1 cnt ! ip> ! <ip ! pnext
slow-next? @ 0=
if ['] forth low-dictionary-adr slow-next
two-windows slow-next? on
then abort ;
: 'unnest (s pfa -- pfa' )
begin #align + dup token@ ['] unnest = until ;
\ Enter and leave the debugger
variable save-status
variable linecounter
: (debug ( acf -- )
['] status >data token@ save-status token!
/token - dup 'unnest (debug) ;
: up1 ( ip -- )
dup find-cfa swap 'unnest (debug) ;
: (trace (s - )
debugger-window cr ." ( " .s ." )"
#out @ 4 + th fc and to-column
r@ token@ >name #columns 1 - over c@ -
dup #out @ - 4 / 1- 0 max 0
1 linecounter +! linecounter @ 2 > if ?do ." . " loop linecounter off else 2drop then
to-column .id
step? @ key? or
if step? on res off .dkeyinfo key upc
case [char] D of r@ token@ (debug endof
[char] U of rp@ cell+ @ up1 endof
[char] C of step? @ not step? ! .dcont endof
[char] F of .dresume forth-window
begin interpret-line res @ until
debugger-window .dtitle endof
[char] G of cr <ip off ip> off .dtitle endof
[char] Q of .dtitle forth-window cr ." unbug" abort endof
endcase
then
forth-window pnext ;
' (trace 'debug token!
only forth also hidden also bug also forth definitions
: debug \ name (s -- )
' (debug ;
: resume (s -- ) res on pnext ;
: step (s -- ) step? on ;
: trace (s -- ) step? off ;
: debug-off (s -- )
unbug here low-dictionary-adr fast-next slow-next? off
(pos? one-window at-xy
save-status token@ is status ;
only forth also definitions
decimal